00100	C  SUBRS.  SLUR, (JUGGLE), (LOOP), PLTSRT, (LINES), (HOMER),
00200	C  (PLACE), (FINDIT), SCL, FORMAT
00300	
00400		SUBROUTINE SLUR
00500		IMPLICIT INTEGER(A-Q,T-Z)
00600		COMMON/SLR/ SLURX(72)
00700		REAL CENTR
00800		COMMON /XRN/RN(4000) /PLTR/PLT,RHT,RDIS
00900		COMMON R2,JA,CENTR,J2,R3,R4,R5,R6,R7,R8,R9,R10,RA,RB,
01000		1 K,KQ,TWICE,RST7,RX,RXX,RTILT,RC,RZ,RW,J3,J4,
01100		1 J5,J6,J7,J8,J9,J10,J11,JQ(8),RJ
01200		COMMON/PTR/PWDS(250),ITEM,L,I,IX /STF/RSTFAC(-3/4),RSJT2
01300		COMMON/ALF/INP,SLURY(72) 
01400	CF	DATA RZZ/2.8/
01500	C  DEFAULT VALUE OF SLUR CURVE FACTOR IS 2.8	
01600	
01700		IF(JA.NE.12)GO TO 2
01800	CF	RA=5.96*RSJT2*R5
01900	CF	L=3
02000	CF	J8=J8*RDIS
02100	CF	IF(J7.LE.J6)J7=J7+360
02200	CF	KQ=6
02300	CF	IF(PLT)KQ=1
02400	CF10	DO 3 K=J6,J7,KQ
02500	CF	R=K
02600	CF	CALL LINES(R3+RA*SIND(R),CENTR+RA*COSD(R),L)
02700	CF3	L=2
02800	CF	J8=J8-1
02900	CF	IF(J8)RETURN
03000	CF	RA=RA+1/RDIS
03100	CF	L=3
03200	CF	GO TO 10
03300	CJA=12  DRAWS CIRCLES. P5=RADIUS, P6=DEGR.1, P7=DEGR.2,P8=THICK(EXPANDS
03400		CALL CIRCLE
03500		RETURN
03600	
03700	C*** SLURS *** 5, POS1, STF, NT1, NT2, POS2, DIP(ABS. UNITS), P8
03800	C        FOR P8: 0= SLUR, 1=BRACKETS, 2=LFT ONLY, 3=RT ONLY
03900	C  P9=NUM IN BRACKET(IF NON-ZERO)
04100	2	J10=1
04200		J4=-1
04300		J5=3
04400	C  ↑↑↑↑ FOR DPY ONLY (1/3 OF SEGS ARE USED)
04500		TWICE=-1
04600	21	RST7=RSJT2*7.
04700		RJ=ABS(R7)
04800	C R7+100=LEFT HALF SLUR, +200=RIGHT HALF, +300=REVERSE DIRECTION.
04900		IF(RJ.LT.100)RJ=-1
05200		R7=AMOD(R7,100.0)
05210		IF(RJ.LT.300)GO TO 20
05220		RJ=0
05230	CC*** NOT YET!	R5=R5-(2*R7)
05240	C R5 THINKS THE SLUR ISN'T REVERSED.
05270	C TO USE THIS ADD R6=SQRT((R5-R4)**2+(R6-R3)**2)+R3(WITH FACTORS)
05300	20	RQQ=R5-R4
05400		IF(R6.GT.1000)CALL RNOTE(R6)
05500		GO TO (5,6,7),J8+4
05600		GO TO 4
05700	5	R=32
05800	C AFTER DOTTED NOTE
05900		GO TO 8
06000	6	R=22
06100	C BETWEEN NOTES
06200	8	RX=-1.3
06300		GO TO 9
06400	7	R=7
06500		RX=RSJT2
06600	9	CALL RJBX(R)
06700		R6=R6+RX
06800	4	RXX=RHORZ(R6)-R3
06900		RTILT=RQQ*RST7
07000	80	RX=SQRT(RXX**2+RTILT**2)
07100		IF(J8.NE.-1)GO TO 1
07200		IF(RQQ.GT.8)RQQ=8
07300		IF(RQQ.LT.-8)RQQ=-8
07400		RQQ=RQQ*RSTFAC(J2)*1.0
07500		IF(R7)RQQ=-RQQ
07600		R3=R3-RQQ
07700	C  MOVES STEEP SLUR LEFT OR RIGHT IF P8=-1
07800	1	R=CENTR
07900		IF(J8.GT.0)GO TO 180
08000		L=72
08100	C  FOR BRACKETS
08200		CALL SLOOP
08300	
08400	CF	RB=RX/71.
08500	CF	DO 81 K=0,71
08600	CF81	SLURX(K+1)=RB*(K)+R3
08700	CF	RA=R7*RST7
08800	CF41	IF(R9.EQ.0)R9=RZZ
08900	CF	R=R+RA
09000	CF	L=0
09100	CF	DO 40 K=36,1,-1
09200	CF	L=L+1
09300	CF	RW=R-RA*(K/36.)**R9
09400	CF	SLURY(L)=RW
09500	CF40	SLURY(73-L)=RW
09600	CF	L=72
09700	
09800	CF89	IF(RTILT.EQ.0)GO TO 87
09900	CF	RW=ATAN2(RTILT,RXX)
10000	CF	RA=SIN(RW)
10100	CF	RB=COS(RW)
10200	CF	RZ=SLURX(1)
10300	CF	RW=SLURY(1)
10400	CF	DO 83 K=1,L
10500	CF	R=SLURX(K)-RZ
10600	CF	RXX=SLURY(K)-RW
10700	CF	SLURX(K)=RB*R-RA*RXX+RZ
10800	CF83	SLURY(K)=RB*RXX+RA*R+RW
10900	
11000	87	IF(J4)CALL LINES(SLURX(J10),SLURY(J10),3)
11100	CC	J5=KQ
11200		J6=J10
11300		J7=L
11400		IF(J4.NE.0)GO TO 22
11500		CALL EXCH(J6,J7)
11600		J5=-1
11700	22	DO 88 K=J6,J7,J5
11800	88	CALL LINES(SLURX(K),SLURY(K),2)
11900		IF(J5.GT.1)CALL LINES(SLURX(72),SLURY(72),2)
12000	C  DISPLAY END POINT OF SLUR
12100		IF(TWICE)RETURN
12200		TWICE=TWICE-1
12300		GO TO 182
12400	180	RW=R+R7*RST7
12500		TWICE=-1
12600	CC	KQ=1
12700		J5=1
12800		RX=RX+R3
12900	CC	RA=(R5-R4)*RST7
13000		IF(J9.EQ.0)GO TO 181
13100		RZ=RTILT/(RX-R3)
13200		TWICE=2
13300	CC	RZ=RX-R3
13400		RXX=RX
13500		RWID=(R3+RXX)/2.
13600	182	IF(TWICE.EQ.1)GO TO 183
13700	C  DOES LEFT SIDE FIRST.
13800		IF(TWICE.EQ.0)GO TO 184
13900	C LAST IS NUMBER.
14000		J8=2
14100		RC=RSJT2*13.
14200		RX=RWID-RC
14300		RWW=RTILT
14400	185	RTILT=RZ*(RX-R3)
14500	
14600	C  PUT IN FUNC. HERE FOR THIS SLOPE AND FOR PART. BEAMS.
14700	
14800		GO TO 181
14900	183	J8=3
15000		RX=RXX
15100		RTILT=RWW
15200		RXX=R3
15300		R3=RWID+RC
15400		RXX=RZ*(R3-RXX)
15500		R=R+RXX
15600		RW=RW+RXX
15700		GO TO 185
15800	
15900	181	SLURX(1)=R3
16000		SLURY(1)=R
16100		SLURX(2)=R3
16200		SLURY(2)=RW
16300		SLURX(3)=RX
16400		SLURY(3)=RW+RTILT
16500		SLURX(4)=RX
16600		SLURY(4)=R+RTILT
16700		L=4
16800		IF(J8.EQ.2)L=3
16900		IF(J8.EQ.3)J10=2
17000	CC	TWICE=-1
17100		GO TO 87
17200	184	J3=RWID
17300	C  PUT IN VERT. POS. WHEN SLOPE!
17400		R4=RQQ/2.+R4+R7-1.
17500		R6=1.
17600	C  R7=1 IS FOR ITALICS
17700		R7=1
17800	C  OR USE 1 FOR ITALIC NUMBERS.
17900		R8=0
18000		CALL MAKNUM(R9)
18100		END
18200	
18300	C********  JUGGLER  ********
18400	CF	SUBROUTINE JUGGLE
18500	CF	IMPLICIT INTEGER(A-Z)
18600	CF	REAL PWDS,RN
18700	CF	COMMON /DL/X22,SAVER,NAME /XRN/RN(4000)
18800	CF    COMMON/PTR/PWDS(250),ITEM,L,I,IX/DPY/ST(4000),WDS(250),MEDIT,IGO
18900	
19000	CF	ITEM=ITEM-1
19100	CF	JX=RN(MEDIT)+3
19200	C  WD CNT OF OLD ITEM
19300	C  I-IX IS WD CNT OF NEW ITEM
19400	CF	JY=IX
19500	CF	Z=I-IX-JX
19600	C  SPACE CHANGE
19700	CF	IF(Z)2751,172,751
19800	CF751	CALL LOOP(I-1,MEDIT+JX,-1,Z,0,RN)
19900	CF	JY=IX+Z
20000	CF	GO TO 172
20100	
20200	CF2751	CALL LOOP(MEDIT+JX+Z,IX+Z-1,1,0,-Z,RN)
20300	
20400	CF172	J=RN(JY)+2
20500	CF	CALL LOOP(0,J,1,MEDIT,JY,RN)
20600	CF	I=IX+Z
20700	
20800	CF1751	X=ITEM+1
20900	CF	JX=WDS(X22+1)-WDS(X22)
21000	CF	J=WDS(X+1)-WDS(X)
21100	CF	Y=J-JX
21200	CF	JX=WDS(X)+Y+1
21300	CF	IF(Y)2851,182,282
21400	CF282	CALL LOOP(WDS(X+1)+2,WDS(X22),-1,Y,0,ST)
21500	CF	GO TO 182
21600	
21700	CF2851	CALL LOOP(WDS(X22+1)+Y+1,WDS(X)+Y+1,1,0,-Y,ST)
21800	CF	JX=WDS(X)+1
21900	
22000	CF182	CALL LOOP(1,J,1,WDS(X22)+1,JX,ST)
22100	CF	DO 183 K=X22+1,X
22200	CF	PWDS(K)=PWDS(K)+Z
22300	CF183	WDS(K)=WDS(K)+Y
22400	CF	ST(2)=WDS(X)
22500	CF	X22=0
22600	CF	END
22700	
22800	
22900	CF	SUBROUTINE LOOP(I,J,K,L,M,N)
23000	CF	DIMENSION N(1)
23100	CF	MM=M-L
23200	CF	DO 1 NN=I+L,J+L,K
23300	CF1	N(NN)=N(NN+MM)
23400	CF	END
23500	
23600	
23700	CXX	SUBROUTINE PLTSRT
23800	C  SORTS DATA TO SHORTEN INVISIBLE VECTORS WHEN PLOTTING. 
23900	CF	IMPLICIT INTEGER(S-Z)
24000	CXX	COMMON /XRN/RN(4000) /PTR/PWDS(250),ITEM,L,I,IX
24100	CXX	COMMON/DPY/Q(3000),P(1000),WDS(250),MEDIT,IGO
24200	C  Q AND P OCCUPY DPY BUFFER.  Q IS FOR OVERFLOW OF RN.
24300	CXX	CALL PSRT(P)
24400	CF	DO 4 K=1,ITEM
24500	CF	L=PWDS(K)
24600	CF	A=RN(L+3)
24700	CF	P(K)=A+1000*RN(L+2)
24800	CF4	IF(A.LT.0)GO TO 77
24900	CF	IF(RN(L+1).NE.16.)GO TO 177
25000	CF77CF	P(K)=-10000
25100	C  PLOTS ALL NEG. HORIZ. POSITIONS AND WORDS(CODE 16) FIRST.
25200	CF177CF	M=I
25300	CF	IF(I.LT.1500)I=1500
25400	CF	Y=I
25500	CF	I=I+M-1
25600	CF	M=Y
25700	C  M IS IN MAIN PROG., LEAVES 1500 WDS IN RN FOR "NOIR" DATA.
25800	CF2CF	A=P(1)
25900	CF	L=1
26000	CF	DO 1 K=1,ITEM
26100	CF	IF(A.LE.P(K))GO TO 1
26200	CF	A=P(K)
26300	CF	L=K
26400	CF1CF	CONTINUE
26500	CF	IF(A.EQ.10000.)RETURN
26600	C  ALL ITEMS HAVE NOW BEEN SHUFFLED
26700	CF	V=PWDS(L)
26800	CF	P(L)=10000
26900	CF	L=RN(V)+2
27000	CF	CALL LOOP(0,L,1,Y,V,RN)
27100	CF	Y=Y+L+1
27200	CF	GO TO 2
27300	CXX	END
27400	
27500	
27600	
27700		SUBROUTINE BOX(I,R,STFF)
27800	      COMMON/SIZ/RSZ,JCEN,KCEN /XRN/RN(4000) /STF/RSTFAC(-3/4),RSJ/C/L,K
27900		DIMENSION STFF(1),N(100)
28000		EQUIVALENCE (N,RN(2901))
28100		IF(I)GO TO 4
28200		K=R
28300		K=(STFF(K+4)+AMOD(RN(I+4),100.0)*7.*RSTFAC(K)
28400		1 -40.0)*RSZ-KCEN
28500	C  ↑↑↑↑ WAS -60.0 10/74
28600	C  AMOD IS FOR MINI NOTES AND CLEFS
28700		L=RHORZ(RN(I+3))*RSZ-JCEN
28800		IF(IABS(L).GT.550)L=511
28900		IF(IABS(K).GT.550)K=511
29000	CC1	CALL ALINE(L,K,L+50,K)
29100	CC	CALL RVECT(0,100)
29200	CC	CALL RVECT(-50,0)
29300	CC	CALL RVECT(0,-100)
29400	CC	L=L+25
29500	CC2	CALL ALINE(L,K-25,L,K+125)
29600	CC3	CALL DPYOUT(1)
29700		CALL SETCUR(L,K,0)
29800		RETURN
29900	4	IF(I.LT.-1)GO TO 5
30000		CALL DPYSET(3,N,100)
30100		CALL DPYBRT(3)
30200	5	L=RHORZ(R)*RSZ-JCEN
30300		IF(IABS(L).GT.550)GO TO 6
30400	C DOESN'T TRY TO DRAW LINE OFF SCREEN
30500		CALL SETPOG(3)
30600		CALL ALINE(L,-511,L,511)
30700		CALL DPYOUT(3)
30800	6	CALL SETPOG(1)
30900		END
31000	
31100	CC	SUBROUTINE LINES(A,B,L)
31200	CC	COMMON/DST/BB,CC
31300	CC	COMMON /SIZ/RSZ,JCEN,KCEN /FL/IC,NZ,NX,RZ,XGP
31400	CC	COMMON/DL/IXRX,SAVER,AA /PLTR/IPLT,RHT,DIS
31500	CC	COMMON R2,JA,CENTR,JB,RJQ(20),JQ(20)
31600	CC	COMMON/DPY/JJ(4000),WDS(250),MEDIT,IGO
31700	CC	EQUIVALENCE (ITOP,JJ(3999)),(IBOT,JJ(4000))
31800	CC	1,(JJ2,JJ(2))
31900	CC	DATA BB/.008/,CC/3.5/
32000	C  SET XGP TO 1200.0 FOR MARGIN IN XEROX COPIES
32100	CC	GO TO 23
32200	CC
32300	CC22	IF(JQ(1).NE.0)GO TO 23
32400	CC	IF(CC.EQ.1000)GO TO 23
32500	C  ABOVE TO SKIP DISTORTION ON COMMAND
32600	C  CHANGE ABOVE TO 'JFCL' IN DDT TO USE NEXT ITEMS.
32700	C  USE THIS IN DDT TO DISTORT ITEMS.  CC MUST BE > DD
32800	CC	B=B*(CC-BB*ABS(A))
32900	C  CC IS HGT FACTOR.
33000	CC23	IF(IPLT)GO TO 2
33100	CC	M=A*RSZ
33200	CC	N=B*RSZ
33300	CC	IF(RSZ.LE.0.8571)GO TO 3
33400	C NEXT FOR DISPLAY MAGNIFICATION
33500	CC	M=M-JCEN
33600	CC	N=N-KCEN
33700	CC	IF(JA.NE.8)GO TO 5
33800	C NEXT INSURES DISPLAY OF STAFF LINES
33900	CC	IF(M.GT.511)M=511
34000	CC	IF(M.LT.-511)M=-511
34100	CC5	IF(IABS(M).GT.512)GO TO 77
34200	CC	IF(IABS(N).LT.512)GO TO 4
34300	C  NOW DRAWS INVISIBLE VECT. IF IT GOES OFF THE SCREEN.
34400	CC77	KZ=-1
34500	CC	RETURN
34600	CC4	IF(KZ.EQ.0)GO TO 6
34700	CC	KZ=0
34800	CC	GO TO 1
34900	CC3	IF(JA.EQ.44)GO TO 6
35000	C JA=44=BAR LINES - THEY DON'T FIGURE IN MAX. HGT.
35100	CC	K=B
35200	CC	IF(K.GT.ITOP)ITOP=B
35300	CC	IF(K.LT.IBOT)IBOT=B
35400	CC6	IF(JJ2.GT.3990)RETURN
35500	CC	IF(L.EQ.3)GO TO 1
35600	CC	CALL AVECT(M,N)
35700	CC	RETURN
35800	CC1	CALL AIVECT(M,N)
35900	CC	RETURN
36000	CC2	IF(IPLT.EQ.-2)RETURN
36100	C RXGP SETS UP-DOWN POS. ON XEROX PAPER (FRACTIONAL POSITIONS POSSIBLE.)
36200	CC9	M=ROFF(A*DIS)
36300	CC	N=ROFF(B*RHT)
36400	CC8	CALL PLOT(M,N,L)
36500	CC	END
36600	
36700	C****** FOR 'HOMING' OF BEAMS AND CHORD NOTES ***********
36800	CF	SUBROUTINE HOMER
36900	CF	IMPLICIT INTEGER(A-Q,S-Z)
37000	CF	REAL PWDS,DISX,A,B,PLACE,STFF
37100	CF	COMMON /STF/RSTFAC(-3/4),RSTJ2
37200	CF    COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /POSI/STFF(-3/4),JJ2,POS
37300	CF	COMMON /XRN/RN(4000) /PTR/PWDS(250),ITEM,L,I,IX
37400	CF	COMMON/ALF/QQ(3),K,RA,RB,N,RG,M,X,RE,RF,A,B,DISX,INP(58)
37500	CF	EQUIVALENCE (R3,RJQ(1)),(R6,RJQ(4)),(J11,JQ(9)),(RD,RN(4000))
37600	CF	1,(R7,RJQ(5)),(R9,RJQ(7)),(R11,RJQ(9)),(R13,RJQ(11))
37700	CF	1,(J10,JQ(8)),(R8,RJQ(6)),(J7,JQ(5))
37800	CF	IF(JA.EQ.6)GO TO 9
37900	CF	IF(R13.NE.0)GO TO 10
38000	C  FOR GENL HOMING; WORDS;  BEAMS;  STEMS;
38100	
38200	CF	IF(JQ(1).EQ.0)GO TO 197
38300	C  TO HOME IN ON NOTE ON DIFFERENT STAFF.
38400	CF	JJ2=R2
38500	CF	K=PWDS(JJ2)
38600	CF	L=PWDS(JQ(1))
38700	CF	RA=RN(K+3)
38800	CF	RB=RN(L+3)
38900	C  RB=POS OF NOTE,  RA=POS(P3) OF BEAM
39000	CF	N=0
39100	CF	IF(RN(L+5).LT.20)N=-1
39200	C  -1 MEANS STEM IS UP
39300	CF	RG=-(AMOD(RN(K+7),10.)-1.)*11./7.
39400	C   SPACE FOR THE NUMB. OF BEAMS
39500	CF	J11=RN(L+2)
39600	CF	M=0
39700	CF	IF(RN(K+7).LT.20.)M=-1
39800	CF	X=RN(K+2)
39900	C  THE STAFF NUMS.  X=BEAM   J11=NOTE
40000	CF	R3=RSTFAC(X)
40100	CF	R9=RSTFAC(J11)/R3
40200	CF	R8=R3*14.54/5.96
40300	C  R8=WIDTH OF NOTE
40400	C******* 5/74  BOTH STAVES MUST BE SAME SIZE - MOST LIKELY ********
40500	CF	R7=96./7.
40600	C  MUST BE DOUBLE STEM LENGTH
40700	CF	RD=RN(L+8)
40800	CCCF	IF(RD.EQ.999)RD=0
40900	C  THE STEM LENGTH
41000	CF3	IF(M.NE.N)GO TO 5
41100	CF	R8=0
41200	CF	R7=0
41300	CF	RG=0
41400	CF	GO TO 4
41500	CF5	IF(M.EQ.0)GO TO 4
41600	CF	R7=-R7
41700	CF	R8=-R8
41800	CF	RD=-RD
41900	CF	RG=-RG
42000	
42100	C  NOT OK IF DIFF SIZES AND RA.GT.RB ****** 5/74
42200	CF4	RN(K+6)=RB+R8
42300	C  SETS CORRECT HORIZANTAL PARAM OF BEAM.
42400	CF	RF=7.*R9
42500	CF	RE=(STFF(J11)-STFF(X))/RF
42600	C  DIST BETWEEN STAVES.
42700	CF	RN(K+5)=RN(L+4)+RE+(R7+RD+RG)*R9
42800	CF	RETURN
42900	
43000	C*********************************************************
43100	C  NEXT ADJUSTS STEMS WHEN BEAMS ARE USED.
43200	CF197	JJ2=-1
43300	
43400	CF	R3=R2
43500	CF	DO 191 K=1,ITEM
43600	CF	L=PWDS(K)
43700	CF	IF(RN(L+1).NE.6)GO TO 191
43800	CF	IF(RN(L+2).EQ.R3)GO TO 77
43900	CF	IF(R3.LT.5.)GO TO 191
44000	C   TYPE 19 99 FOR ALL STAVES
44100	CF77	RG=RN(L+7)
44200	CF	IF(RN(L).EQ.8)GO TO 191
44300	CF	IF(RG.LT.10.)GO TO 191
44400	C  FINDS BEAMS.
44500	CF	A=RN(L+3)-.01
44600	CF	B=RN(L+6)+.01
44700	C  POS 1 AND 2
44800	CF	DISX=B-A
44900	C  DISTANCE IN REAL STEPS
45000	CF	RB=AMOD(RN(L+5),100.0)
45100	C  NOTE 2
45200	CF	RF=AMOD(RN(L+4),100.0)
45300	CF	RD=RB-RF
45400	C  HEIGHT
45500	CF	R2=RN(L+2)
45600	C  ↑↑↑ USED IN 'FINDIT'
45700	CF	X=RG/10.
45800	C  STEM DIRECT.
45900	
46000	CF	DO 192CF	N=1,ITEM
46100	CF	IF(FINDIT(N))GO TO 192
46200	CF	IF(RN(L).EQ.8)GO TO 192
46300	CF	IF(RN(L+8).EQ.1000.)GO TO 192
46400	C SKIPS SLASHED GRACE NOTES (P8=1000 OR P10=1)
46500	C  FINDIT IS NEG. IF(RN(L+1).NE.1.OR.RN(L+3))
46600	CF	RC=RN(L+3)
46700	CF	IF(RC.LT.A)GO TO 192
46800	CF	IF(RC.GT.B)GO TO 192
46900	C  WHAT'S LEFT IS IN BEAM AREA IF STEM DIR. IS OK.
47000	CF	IF(X.NE.IFIX(RN(L+5)/10.))GO TO 192
47100	CF	RC=RC-A
47200	CF193	RE=AMOD(RN(L+4),100.0)
47300	CF	RC=RD*RC/DISX+RF
47400	CF	RG=RN(L+7)
47500	CF	RN(L+7)=RG-AMOD(RG,10.0)+AMOD(RG,1.0)
47600	C   DELETES TAILS WITHOUT REMOVING DOTS OR SPACING OF DOTS.
47700	C  FRACTIONAL NOTE #
47800	CF195	RA=RC-RE
47900	CF	IF(X.EQ.2)RA=-RA
48000	CF	IF(RA.EQ.0)RA=999.
48100	CF196	RN(L+8)=RA
48200	C  FRACTIONAL NOTE # - FIRST NOTE OF GROUP + THIS NOTE # ALL *7.
48300	CF	IF(JJ2)JJ2=N
48400	C  SAVES # OF FIRST ITEM FOUND
48500	CF192	CONTINUE
48600	CF191	CONTINUE
48700	CF	RETURN
48800	
48900	C*********************************************************
49000	CF9	IF(J11.LT.0)RETURN
49100	C   IF P11=-1 NO HOMING
49200	CF	X=R7/10.
49300	CF	IF(X)X=-X
49400	C  X IS STEM DIRECTION
49500	CF	RA=R9
49600	C  R9= POS3
49700	CF	RC=-1.
49800	CF	IF(R9.NE.0)RC=-2.
49900	CF	IF(J10/10.EQ.3)RC=-3
50000	C  RC=1 ESCAPES FROM LOOP.
50100	C   HOMING RANGE FOR BEAMS
50200	CF10	IF(R11.EQ.0)R11=2.9
50300	C   IF P11.NE.0 RANGE IS CHANGED FROM 2
50400	CF	IF(JA.EQ.5)RC=-1
50500	C******↑↑↑↑↑↑↑ WAS 8????
50600	CF	DO 361 K=1,ITEM
50700	CF	IF(FINDIT(K))GO TO 361
50800	C  SKIPS NOTES ON WRONG LINE 
50900	CF	RD=RN(L+3)
51000	CF1	IF(JA.NE.6)GO TO 177
51100	CF	IF(IFIX(RN(L+5)/10).NE.X)GO TO 361
51200	CF177	IF(PLACE(R3))GO TO 461
51300	CF	R3=RD
51400	C  LOOKS FOR NOTE, STAFF #, STEM DIR.
51500	CF	IF(JA.EQ.6)GO TO 861
51600	CF	IF(JA.EQ.5)GO TO 261
51700	CF	RETURN
51800	
51900	CF461	IF(JA.EQ.6)GO TO 277
52000	CF	IF(JA.NE.5)GO TO 361
52100	CF277	IF(PLACE(R6))GO TO 561
52200	CF	R6=RD
52300	CF861	IF(J7.GE.0)GO TO 261
52400	CF561	IF(PLACE(RA))GO TO 661
52500	CF	IF(J7)GO TO 761
52600	C  J7=NEG MEANS TREMOLO
52700	CF	IF(R8.EQ.0)GO TO 361
52800	CF761	R9=RD
52900	C  R8=0 MEANS R9 IS NUMBER OUTSIDE OF BEAM.
53000	CF	GO TO 261
53100	CF661	IF(JA.EQ.5)GO TO 361
53200	CF	IF(J10.LT.30)GO TO 361
53300	CF	IF(PLACE(R8))GO TO 361
53400	C  HOMES INNER PARTIAL BEAMS
53500	CF	R8=RD
53600	CF261	RC=RC+1
53700	CF	IF(RC.EQ.1.)RETURN
53800	CF361	CONTINUE
53900	CF	END
54000	
54100	CF	FUNCTION PLACE(X)
54200	CF	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/XRN/RN(4000)
54300	CF	EQUIVALENCE (R11,RJQ(9)),(RD,RN(4000))
54400	CF	PLACE=R11-ABS(RD-X)
54500	CF	END
54600	
54700	CF	FUNCTION FINDIT(N)
54800	CF	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
54900	CF	COMMON /XRN/RN(4000) /PTR/PWDS(250),ITEM,L,I,IX
55000	CF	FINDIT=0
55100	CF	L=PWDS(N)
55200	CF	IF(RN(L+1).NE.1)GO TO 377
55300	CF	IF(RN(L+2).EQ.R2)RETURN
55400	CF377	FINDIT=-1
55500	CF	END
55600	
55700		SUBROUTINE SCL
55800	C  SETS UP SCALING MARKERS.
55900		DIMENSION SU(400)
56000		COMMON /STF/RSTFAC(-3/4),RSTJ2 /XRN/RN(4000)
56100		COMMON R2,JA,CT,J2,R3,R4,R5,RJQ(17),J3,J4,J5,J6,J(16)
56200		1 /POSI/STFF(-3/4),J102,POS
56300		EQUIVALENCE (SU(400),RN(3001))
56400		J2=R2
56500		IF(J2.NE.99)GO TO 1008
56600		CALL HYDPOG(2)
56700		RETURN
56800	1008	J5=0
56900		J6=0
57000		RSTJ2=RSTFAC(J2)
57100	C  SETS UP SCALE LINES.
57200		J4=200
57300		IF(R3.NE.0)J4=400
57400	C  PUTS SCALE TO 400
57500		R2=STFF(J2)+60.*RSTJ2
57600		RJ=R2+60.
57700		CALL DPYSET(2,SU,700)
57800		CALL DPYBRT(1)
57900		POS=RJ+40.
58000		RSTJ2=1.
58100		DO 1002 MX=10,J4,10
58200		RA=RHORZ(FLOAT(MX))
58300		R3=RA-58
58400		IF(MX.GT.10)CALL PNUM
58500	CC1005	IF(R5.NE.0)GO TO 1007
58600	C  JUMP FOR STAFF NUMBERS
58700		CALL LINX(RA,R2,RA,RJ)
58800		J5=J5+1
58900	1002	IF(J5.EQ.10)J5=0
59000		CALL LINES(-596.0,RJ,2)
59100		CALL LINES(-596.0,R2,2)
59200		R6=1.5
59300	C  NEXT SETS UP STAFF NUMBERS
59400		R3=-620.
59500		DO 1007 K=-3,4
59600		POS=STFF(K)+40.
59700		J5=IABS(K)
59800		CALL PNUM
59900	1007	CONTINUE
60000		CALL DPYOUT(2)
60100		CALL SETPOG(1)
60200		END
60300	
60400	C  NEXT ALLOWS YOU TO TYPE 'SA NAME' OR 'SAVE NAME' ETC.
60500	C  (NO MORE THAN 9 CHARS. MAY COME BEFORE NAME)
60600		SUBROUTINE FORMAT(NAME)
60700	C  SO WE CAN TYPE 'SA NAME' OR 'SAVE    NAME', ETC.
60800		COMMON /ALF/INP(72),ML 
60900		DIMENSION DMY(50),IFMT(2)
61000		EQUIVALENCE (INP(20),DMY)
61100		DATA IFMT(2)/' ,A5)'/
61200	
61300		DO 1 K=2,72
61400		IF(INP(K).NE.' ')GO TO 1
61500		DO 2 L=K+1,72
61600		IF(INP(L).EQ.' ')GO TO 2
61700	C NOW WE START NAME
61800		L=L-1
61900	5	IFMT(1)='( 0A1'+L*32768
62000	C  32768 IS MAGIC NUM TO CHANGE '0' TO RIGHT NUM.
62100		REREAD IFMT,(DMY(K),K=1,L),NAME
62200		RETURN
62300	2	CONTINUE
62400		NAME=' '
62500		RETURN
62600	1	CONTINUE
62700		END